home *** CD-ROM | disk | FTP | other *** search
/ MacGames Sampler / PHT MacGames Bundle.iso / MacSource Folder / Samples from the CD / Pascal / Source□ / Talk Source / PrefsGlobals.p next >
Encoding:
Text File  |  1992-04-20  |  3.5 KB  |  159 lines  |  [TEXT/PJMM]
  1. unit PrefsGlobals;
  2.  
  3. { This program was written by Peter N Lewis, Mar 1992 in THINK Pascal 4.0.1 }
  4.  
  5. interface
  6.  
  7.     const
  8.         prefs_version = $0100;
  9.         prefsCreator = 'tALK';
  10.         prefsType = 'Talk';
  11.         prefsResType = 'PREF';
  12.         prefsResID = 128;
  13.         prefsStrhResID = 128;
  14.         prefsNameStrhIndex = 1;
  15.         prefsFinderCommentStrhIndex = 2;
  16.  
  17.     type
  18.         prefsRecord = record
  19.                 version: integer;
  20.                 allowconnect: (AC_Talkd, AC_Talk, AC_never);
  21.                 notify_alert: boolean;
  22.                 notify_beep: boolean;
  23.                 notify_flash: boolean;
  24.                 show_status: boolean;
  25.                 auto_talk: boolean;
  26.                 close_status: boolean;
  27.                 reply_if_idle: boolean;
  28.                 answer_to_anyname: boolean;
  29.                 type_in_bottom_pane: boolean;
  30.                 no_return_delete: boolean;
  31.                 dummy: array[14..20] of signedByte;
  32.                 usernames: str255;
  33.             end;
  34.  
  35.     var
  36.         prefs: prefsRecord;
  37.  
  38.     procedure ValidatePrefs (var prefs: prefsRecord);
  39.     procedure ValidateUserNames (var s: str255);
  40.     function ValidUserNames (s: str255): boolean;
  41.     function GetMyUserName (var prefs: prefsRecord): str255;
  42.     function ValidUserName (s: str255; var prefs: prefsRecord): boolean;
  43.  
  44. implementation
  45.  
  46.     uses
  47.         MyTypes;
  48.  
  49.     procedure SimpleValidateUserNames (var s: str255);
  50.         var
  51.             t: str255;
  52.             i: integer;
  53.     begin
  54.         for i := 1 to length(s) do
  55.             if not (s[i] in ['a'..'z', 'A'..'Z', '_', '1'..'9']) then
  56.                 s[i] := spc;
  57.         t := '';
  58.         i := 1;
  59.         while (i <= length(s)) & (s[i] = spc) do
  60.             i := i + 1;
  61.         while i <= length(s) do begin
  62.             while (i <= length(s)) & (s[i] <> spc) do begin
  63.                 t := concat(t, s[i]);
  64.                 i := i + 1;
  65.             end;
  66.             if i <= length(s) then
  67.                 t := concat(t, ',', spc);
  68.             while (i <= length(s)) & (s[i] = spc) do
  69.                 i := i + 1;
  70.         end;
  71.         s := t;
  72.     end;
  73.  
  74.     function ValidUserNames (s: str255): boolean;
  75.         var
  76.             t: str255;
  77.             i, j: integer;
  78.     begin
  79.         SimpleValidateUserNames(s);
  80.         ValidUserNames := s <> '';
  81.     end;
  82.  
  83.     procedure ValidateUserNames (var s: str255);
  84.         var
  85.             sh: stringHandle;
  86.             i: integer;
  87.     begin
  88.         SimpleValidateUserNames(s);
  89.         if s = '' then begin
  90.             sh := GetString(-16096);
  91.             if sh = nil then
  92.                 sh := GetString(-16413);
  93.             if sh <> nil then begin
  94.                 s := sh^^;
  95.                 ReleaseResource(handle(sh));
  96.                 SimpleValidateUserNames(s);
  97.             end;
  98.         end;
  99.         if s = '' then
  100.             s := 'macintosh'; { I give up! }
  101.         for i := 1 to length(s) do
  102.             if s[i] in ['A'..'Z'] then
  103.                 s[i] := chr(ord(s[i]) + $20);
  104.     end;
  105.  
  106.     function GetMyUserName (var prefs: prefsRecord): str255;
  107.         var
  108.             p: integer;
  109.     begin
  110.         p := Pos(',', prefs.usernames);
  111.         if p = 0 then
  112.             GetMyUserName := prefs.usernames
  113.         else
  114.             GetMyUserName := copy(prefs.usernames, 1, p - 1);
  115.     end;
  116.  
  117.     procedure ValidatePrefs (var prefs: prefsRecord);
  118.         var
  119.             i: integer;
  120.     begin
  121.         with prefs do begin
  122.             if version <> prefs_version then begin
  123.                 version := prefs_version;
  124.                 allowconnect := AC_talkd;
  125.                 notify_alert := false;
  126.                 notify_beep := true;
  127.                 notify_flash := true;
  128.                 show_status := true;
  129.                 auto_talk := false;
  130.                 close_status := false;
  131.                 reply_if_idle := false;
  132.                 answer_to_anyname := true;
  133.                 type_in_bottom_pane := false;
  134.                 no_return_delete := false;
  135.                 usernames := '';
  136.             end;
  137.             for i := 14 to 20 do
  138.                 dummy[i] := 0;
  139.             ValidateUserNames(usernames);
  140.         end;
  141.     end;
  142.  
  143.     function ValidUserName (s: str255; var prefs: prefsRecord): boolean;
  144.         var
  145.             i: integer;
  146.     begin
  147.         with prefs do begin
  148.             if answer_to_anyname then
  149.                 ValidUserName := true
  150.             else begin
  151.                 for i := 1 to length(s) do
  152.                     if ('A' <= s[i]) and (s[i] <= 'Z') then
  153.                         s[i] := chr(ord(s[i]) + $20);
  154.                 ValidUserName := (s = usernames) or (Pos(concat(s, ','), usernames) <> 0) or (Pos(concat(', ', s), usernames) <> 0);
  155.             end;
  156.         end;
  157.     end;
  158.  
  159. end.